home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
FRPG.PRG
< prev
next >
Wrap
Text File
|
1992-09-28
|
17KB
|
419 lines
*-------------------------------------------------------------------------------
*-- Program...: FRPG.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 09/28/1992
*-- Notes.....: These are Fantasy Role-Playing Game routines. For examples of
*-- the use of these routines, in much detail, I have a gaming
*-- system (constantly being modified) that uses these routines
*-- extensively. It's a fantasy system, based in 'Middle Earth'.
*-- It includes: Character Generation (updating, printing, deleting);
*-- Random Encounters (Wilderness and City); and Random Treasure
*-- Generation. If interested, contact me. Information is in
*-- README.TXT. This system is not yet ready for 'public
*-- consumption', but sometime early 1992 ... (RSN <G>)
*-------------------------------------------------------------------------------
PROCEDURE SetRand
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 02/18/1992
*-- Notes.......: A small procedure used to set a random number table. Used with
*-- DICE(), etc. below, it can be quite handy. NOTE: You should
*-- use EITHER this routine, OR RAND(-1) (built in to dBASE).
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Do SetRand
*-- Example.....: Do SetRand
*-- Returns.....: None
*-- Parameters..: None
*-------------------------------------------------------------------------------
private x,nSeed
nSeed = (val(substr(time(),1,2)) + val(substr(time(),4,2))+;
val(substr(time(),7,2))) * val(substr(time(),7,2))
x=int(rand(nSeed) * 6) + 1
RETURN
*-- EoP: SetRand
FUNCTION Dice
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 02/13/1992
*-- Notes.......: A small function used to determine a random number from
*-- 1 to x. Used for gaming purposes.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 05/23/1991 - original function.
*-- 02/13/1992 -- Ken Mayer -- discovered after playing with this
*-- that there are some problems with resetting the random table
*-- each time. This has been removed. It also means that a
*-- couple of routines that used to be based on this can use
*-- it better (see: MULTDICE() below ...)
*-- Calls.......: None
*-- Called by...: Any
*-- MULTDICE() Function in FRPG.PRG
*-- Usage.......: Dice(<nSides>)
*-- Example.....: nVal = Dice(4)
*-- Returns.....: Random # between 1 and <nSides>
*-- Parameters..: nSides = # of sides of die to be cast ... (RPG dice
*-- include 4, 6 (standard), 8, 10, 12, 20, 100 ...
*-------------------------------------------------------------------------------
parameters nSides
*-- return a random number from 0 to nSides -1 and add 1 to it ...
RETURN int(rand() * nSides) + 1
*-- EoF: Dice()
FUNCTION MultDice
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 02/13/1992
*-- Notes.......: Function like above, used to determine a random #,
*-- but for multiple dice, of x# of sides.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 06/12/1991 - original function.
*-- 02/13/1992 -- cleaned up to call DICE() above for each
*-- iteration, rather than calling once and then redoing the
*-- randomizer logic ... I was setting the random table
*-- in the DICE() function, but decided it was more trouble
*-- than it was worth ... resetting it too fast (i.e., in a loop)
*-- and I was getting the exact same number 2 to 4 times in a
*-- row ... not worth it. SO, I don't anymore.
*-- Calls.......: DICE() Function in FRPG.PRG
*-- Called by...: Any
*-- Usage.......: MultDice(<nNum>,<nSides>)
*-- Example.....: nVal = MultDice(3,6)
*-- Returns.....: Random value of 1 to x (x being number of sides),
*-- for each iteration (nNum), totalled. For example,
*-- value returned would be the total of 3 six-sided die
*-- rolled, the number would be anywhere from 3 to 18.
*-- Parameters..: nNum = Number of dice to be "rolled"
*-- nSides = # of sides to the dice (see Dice() above)
*-------------------------------------------------------------------------------
parameters nNum,nSides
private nCount,nTotal
nCount = 0 && set counter
nTotal = 0 && set total
do while nCount < nNum && loop for number of dice
nCount = nCount + 1 && increment counter
nTotal = nTotal + dice(nSides) && add to total
enddo
RETURN nTotal
*-- EoF: MultDice()
FUNCTION ValiDice
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 06/08/1992
*-- Notes.......: Used to ask user for input of a number within a range
*-- based on gaming dice. Programmer supplies # of dice,
*-- and number of sides to function, it returns the input
*-- from the user (and only allows valid input).
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 07/09/1991 - original function.
*-- 02/13/1992 -- modified to handle user pressing <Esc>.
*-- 06/08/1992 -- explicit color handling
*-- Calls.......: SHADOW Procedure in PROC.PRG
*-- CENTER Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: ValiDice(<nNum>,<nDice>,"<cMessage>","<cColor>")
*-- Example.....: replace STRENGTH with ValiDice(3,6,"Strength",;
*-- "rg+/gb,w/n,rg+/gb") && 3 6-sided
*-- Returns.....: Valid user input
*-- Parameters..: nNum = Number of dice
*-- nSides = Number of sides
*-- cMessage = Message for line 0
*-- cColor = Colors for window
*-------------------------------------------------------------------------------
PARAMETERS nNum, nDice, cMessage, cColor
private nUpper,nUser
save screen to sDice
activate screen
define window wDice from 8,20 to 14,60 double color &cColor
do shadow with 8,20,14,60
activate window wDice
nUpper = nNum * nDice && upper limit
do center with 0,40,"","&cMessage"
do center with 1,40,"","Enter a value from "+ltrim(str(nNum))+" to "+;
ltrim(str(nUpper))
do center with 2,40,"","("+ltrim(str(nNum))+"d"+ltrim(str(nDice))+")"
nUser = 0
do while .t.
@4,18 get nUser picture "999" valid required nUser => nNum .and.;
nUser =< nUpper;
error chr(7)+"Enter a valid number!"
read
if lastkey() = 27
?? chr(7)
else
exit
endif
enddo
deactivate window wDice
release window wDice
restore screen from sDice
release screen sDice
RETURN nUser
*-- EoF: ValiDice()
FUNCTION DiceChoose
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 06/08/1992
*-- Notes.......: This is another FRPG routine -- It is used to give the
*-- user a choice of three die roles. The computer will
*-- randomly generate a die roll three times so the user
*-- has a choice.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 07/09/1991 - original function
*-- 02/13/1992 -- Modified to only require use of MULTDICE(),
*-- not a call to DICE() AND MULTDICE() ... also modified to
*-- deal with user pressing <Esc> (it beeps at 'em).
*-- 06/08